COMMENT ⊗   VALID 00014 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE	DAP
C00004 00003	Flags and storage allocation
C00006 00004	REDAP--initialization
C00007 00005	Main loop
C00008 00006	DAP2    NXSTY   DSPLAY
C00011 00007	MOVEUP  MOVEDN  REDRAW  ORIGI   FOLLOW  LEAVE   EDDT    ALTER   NO      OUTSEQ
C00013 00008	BACK    BACK1   AHEAD   AHEAD1  NEWEST  OLDEST  TOP     BOTTOM
C00015 00009	NEXT    LAST    PRSTY   PLUS    MINUS
C00017 00010	INNBR   RDNBR   PTZERO  PRNTNO  NXTDG
C00019 00011	READIT
C00023 00012	READ    GETCH
C00024 00013	CLEAR   DISP
C00026 00014	CHRTBL
C00028 ENDMK
C⊗;
	TITLE	DAP

EXTERN $I,JOBDDT

F←←0
A←1
B←2
C←3
D←4
S←5
X←6
N←7

P←17

CR←←15  LF←←12  FF←←14  VT←←13  ALT←←175  TAB←←11

; DATA-DISC MACROS AND DEFINITIONS
; COMMAND WORD -- ALTERNATING COMMANDS AND PARAMETERS
DEFINE CW(C1,B1,C2,B2,C3,B3) <
	<BYTE (8)<B1>,<B2>,<B3> (3)<C1>,<C2>,<C3>>!4
>

; COMMAND NAMES FOR DD COMMAND BYTES
EXCT←←0				;EXECUTE
FNCN←←1  ALPHBG←←16  ALPHA←←46	;FUNCTION, USUAL VALUE BYTES
CHNL←←2				;CHANNEL SELECT
COLM←←3				;COLUMN SELECT
HILIN←←4			;HIGH 5 BITS OF LINE
LOLIN←←5			;LOW 5 BITS OF LINE

OPDEF DDUPG  [PGIOT 3,]
OPDEF SLEEP  [CALLI 31]
OPDEF EXIT   [CALLI 12]
OPDEF SNEAKW [CALLI 400063]
OPDEF INSKIP [TTYUUO 13,]
OPDEF SETACT [TTYUUO 15,]
;Flags and storage allocation

;LEFT HALF FLAGS
BACKUP←←      1	; 1 if we want to display the last frame of a story

FRSIZE←←=15
MAXFRS←←20

SPECS←←4
XSIZE←←3
MAXNBR←=500
XLEN←MAXNBR*XSIZE+SPECS

PDLEN←←40

PDLIST:	BLOCK	PDLEN

STORY:	BLOCK	2200
INDEX:	BLOCK	XLEN
FREND:	BLOCK	MAXFRS+1
STUFF:	BLOCK	20
DIGITS:	BLOCK	4
SEQNBR:	0
LINEBP:	0
BRCHAR:	0
FRAME:	0
LASTFR:	0

NEWSF:	SIXBIT	/NEWS/
	BLOCK	3

CMD:	IOWD	1,STORY
	0

INDEXF:	SIXBIT	/INDEX/
	BLOCK	3

XCMD:	IOWD	XLEN,INDEX
	0

DSK17:	17
	SIXBIT	/DSK/
	0

DDERAS:	CW FNCN,17,CHNL,0,FNCN,ALPHA
	0
DDHDR:	200000,,
	BLOCK	3

DEFINE	UNDUNX	{INDEX}
DEFINE	NEWX	{INDEX+1}
DEFINE	OLDX	{INDEX+2}

DEFINE	ERROR (MSG)  {
JRST	[OUTSTR	[ASCIZ ⊗
MSG
⊗]
	 HALT .+1]
}

CRLF:	ASCIZ/
/
;REDAP--initialization

REDAP:	OUTSTR	[ASCIZ/ RESTARTING/]
DAP:	MOVE	P,[IOWD PDLEN,PDLIST]
	PPSEL	1
	OPEN	0,DSK17
	ERROR	OPEN FAILED ON DSK
	MOVE	A,[' APSYS']
	MOVEM	A,INDEXF+3
	LOOKUP	0,INDEXF
	ERROR	LOOKUP FAILED ON INDEX
	IN	0,XCMD
	JRST	.+2
	ERROR	IN FAILED ON INDEX
	RELEAS	0,
	SETZM	SEQNBR
	MOVE	X,OLDX
DAPC:	PUSHJ	P,CLEAR			;clear screen and position pp at bottom
	SETACT	[0,,[-1↔777700037777↔-1↔777777600000]];activate on anything but digits
	SETLIN	[000120,,0]
	JRST	BACK1
;Main loop

NOTFND:	OUTSTR	[ASCIZ/ NOT FOUND./]
DAP0:	OUTSTR	[ASCIZ/ OK
/]
DAP1:	TLZ	F,BACKUP
	INCHWL	C
	MOVE	X,CURX
	LDB	A,[POINT 2,C,28]	;grab control bits
	ANDI	C,177			;and zero them
	JRST	@CHRTBL(C)
;DAP2    NXSTY   DSPLAY

NUMBER:	PUSH	P,C
	PUSHJ	P,READ
	POP	P,C
	PUSHJ	P,RDNBR

DAP2:	MOVEM	N,SEQNBR
	MOVE	X,OLDX
	JRST	NXSTY2
NXSTY:	OUTSTR	[ASCIZ/LATER STORY #/]
	MOVE	C,SEQNBR
	PUSHJ	P,PRNTNO
NXSTY1:	ADDI	X,XSIZE
	CAIL	X,XLEN
	MOVEI	X,SPECS
	CAMN	X,NEWX
	JRST	NOTFND
NXSTY2:	HRRZ	A,INDEX+2(X)		;get seq nbr of this story
	CAME	A,SEQNBR
	JRST	NXSTY1

DSPLAY:	PUSHJ	P,READIT			;display the story whose index is in X
	OUTSTR	[ASCIZ / SEQ NBR CALC FAIL /]

	MOVE	A,[-2200,,STORY]
	MOVEI	B,1
	ORM	B,(A)
	AOBJN	A,.-1
	HRLI	D,440700
	SETZ	B,
	MOVEM	D,FREND(B)
	JRST	CTLFS1
CTLFS0:	SOJG	C,CTLFS
	ADDI	B,1
	CAIL	B,MAXFRS
	ERROR	STORY TOO LONG
	MOVEM	D,FREND(B)
CTLFS1:	MOVEI	C,FRSIZE
CTLFS:	ILDB	A,D
	CAIN	A,LF
	JRST	CTLFS0
	JUMPN	A,CTLFS
	MOVEM	D,FREND+1(B)
	MOVEM	D,FREND+2(B)
	SOJG	B,CTLFS2
	SETZ	B,
	JRST	CTLFS3

CTLFS2:	MOVE	C,FREND+1(B)
CTLFS4:	ILDB	A,C
	JUMPE	A,CTLFS5
	CAIE	A,LF
	JRST	CTLFS3
	CAME	C,D
	JRST	CTLFS4
CTLFS5:	SUBI	B,1

CTLFS3:	MOVEM	B,LASTFR
	TLZN	F,BACKUP
	SETZ	B,
	MOVEM	B,FRAME
	PUSHJ	P,DISP
	JRST	DAP0
;MOVEUP  MOVEDN  REDRAW  ORIGI   FOLLOW  LEAVE   EDDT    ALTER   NO      OUTSEQ

MOVEUP:	MOVE	A,FRAME
	CAML	A,LASTFR
	JRST	AHEAD1
	AOS	B,FRAME
	PUSHJ	P,DISP
	JRST	DAP0

MOVEDN:	SKIPG	FRAME
	JRST	[TLO F,BACKUP↔JRST BACK1]
	SOS	B,FRAME
	PUSHJ	P,DISP
	JRST	DAP0

REDRAW:	MOVE	B,FRAME
	PUSHJ	P,DISP
	JRST	DAP0

ORIGI:	OUTSTR	[ASCIZ/ ORIGINAL/]
	HLRZ	X,INDEX+2(X)
	JUMPN	X,DSPLAY
	JRST	NOTFND

FOLLOW:	OUTSTR	[ASCIZ/ FOLLOW UP/]
	HRRE	X,INDEX(X)
	JUMPG	X,DSPLAY
	JRST	NOTFND

LEAVE:	PUSHJ P,CLEAR
	EXIT

EDDT:	SKIPE	JOBDDT
	JSR $I
	JRST DAP0

ALTER:
NO:	OUTSTR	[ASCIZ/ LEGAL COMMANDS ARE: <nbr> FF VT /]
	SETZ	C,
NO1:	HRRZ	B,CHRTBL(C)
	CAIE	B,NUMBER
	CAIN	B,NO
	JRST	NO2
	CAIE	C,VT
	CAIN	C,FF
	JRST	NO2
	OUTCHR	C
	OUTCHR	[" "]
NO2:	ADDI	C,1
	CAIGE	C,"a"
	JRST	NO1
	OUTSTR	CRLF
	JRST	DAP1

OUTSEQ:	MOVE	C,SEQNBR
	PUSHJ	P,PRNTNO
	JRST	DAP0
;BACK    BACK1   AHEAD   AHEAD1  NEWEST  OLDEST  TOP     BOTTOM

BACK:
BACK1:	CAMN	X,OLDX
	JRST	BACK2
BACK3:	SUBI	X,XSIZE
	CAIGE	X,SPECS
	MOVEI	X,XLEN-XSIZE
	JRST	DSPLAY
NEWEST:	
BACK2:	OUTSTR	[ASCIZ/ NEWEST STORY/]
	MOVE	X,NEWX
	JRST	BACK3

AHEAD:
AHEAD1:	ADDI	X,XSIZE
	CAIL	X,XLEN
	MOVEI	X,SPECS
	CAME	X,NEWX
	JRST	DSPLAY
OLDEST:	
AHEAD2:	OUTSTR	[ASCIZ/ OLDEST STORY/]
	MOVE	X,OLDX
	JRST	DSPLAY


TOP:	SETZB	B,FRAME
	PUSHJ	P,DISP
	JRST	DAP0

BOTTOM:	MOVE	B,LASTFR
	MOVEM	B,FRAME
	PUSHJ	P,DISP
	JRST	DAP0
;NEXT    LAST    PRSTY   PLUS    MINUS

PLUS:	PUSHJ	P,READ
	PUSHJ	P,INNBR
	CAILE	N,=150
	MOVEI	N,=150
	IMULI	N,XSIZE
	ADD	X,N
	CAIL	X,XLEN
	SUBI	X,XLEN-SPECS
	JRST	PLMNCK

MINUS:	PUSHJ	P,READ
	PUSHJ	P,INNBR
	CAILE	N,=150
	MOVEI	N,=150
	IMULI	N,XSIZE
	SUB	X,N
	CAIGE	X,SPECS
	ADDI	X,XLEN-SPECS
PLMNCK:	MOVE	A,OLDX
	CAMLE	A,NEWX
	JRST	PLMNC1
	CAML	X,A
	CAML	X,NEWX
	JRST	NOTFND
	JRST	DSPLAY
PLMNC1:	CAML	X,NEWX
	CAML	X,A
	JRST	DSPLAY
	JRST	NOTFND

NEXT:	INCHRW	C
	ANDI	C,177
	CAIE	C,"+"
	ERROR	PLUS SIGN DISAPPEARED
	JUMPN	A,NXSTY
	PUSHJ	P,READ
	PUSHJ	P,INNBR
	JUMPE	N,NXSTY
	MOVEM	N,SEQNBR
	JRST	NXSTY

LAST:	INCHRW	C
	ANDI	C,177
	CAIE	C,"-"
	ERROR	MINUS SIGN DISAPPEARED
	JUMPN	A,PRSTY
	PUSHJ	P,READ
	PUSHJ	P,INNBR
	JUMPE	N,PRSTY
	MOVEM	N,SEQNBR
PRSTY:	OUTSTR	[ASCIZ/EARLIER STORY #/]
	MOVE	C,SEQNBR
	PUSHJ	P,PRNTNO
PRSTY1:	CAMN	X,OLDX
	JRST	NOTFND
	SUBI	X,XSIZE
	CAIGE	X,SPECS
	MOVEI	X,XLEN-XSIZE
	HRRZ	A,INDEX+2(X)
	CAME	A,SEQNBR
	JRST	PRSTY1
	JRST	DSPLAY
;INNBR   RDNBR   PTZERO  PRNTNO  NXTDG

INNBR:	ILDB	C,LINEBP	;load 1st char of number
RDNBR:	SETZ	N,		;CNT will hold the value of the number
RDNBR1:	CAIG	C,"9"		;is present char a digit?
	CAIGE	C,"0"
	POPJ	P,		;no.  return
	IMULI	N,=10		;yes.  multiply previous sum by =10 and
	ADDI	N,-60(C)	;	add in current digit
	ILDB	C,LINEBP	;load the next potential digit
	JRST	RDNBR1

PTZERO:	CAIGE	C,=10
	OUTCHR	["0"]		;print a leading zero if number is less than ten
PRNTNO:	MOVE	B,[POINT 7,DIGITS]
	PUSHJ	P,NXTDG
	SETZ	C,
	IDPB	C,B
	OUTSTR	DIGITS
	POPJ	P,

NXTDG:	IDIVI	C,=10
	PUSH	P,D
	SKIPE	C
	PUSHJ	P,NXTDG
	POP	P,C
	ADDI	C,60
	IDPB	C,B
	POPJ	P,
;READIT

READIT:	HRRZ	D,INDEX+1(X)		;get the story's displ from beginning of rec
	MOVE	S,X			;calculate the index of the next story
	ADDI	S,XSIZE
	CAIL	S,XLEN
	MOVEI	S,SPECS
	MOVN	S,INDEX+1(S)		;subtract the rec nbr and displ of next story from zero
	ADD	S,INDEX+1(X)		;	and add in the rec nbr and displ of the
	JUMPL	S,ONWARD		;	current story. this gets negated size of current story
DOWN:	MOVN	S,INDEX+3		;the current story is the bottom one in NEWS
	JUMPN	S,.+2			;zero means this is a fake story. NEWS has never wrapped around
	ERROR	FAKE STORY
	ADD	S,INDEX+1(X)		;recalculate its size using ptr to bottom of file
ONWARD:	ASH	S,-13
;shift out the =11 low order zero bits of the size
	ASH	D,-13			;shift out the =11 low order zero bits of the displ
	MOVNM	S,TOTSIZ#		;save the size of the story (positive size)
	SUB	S,D			;add in the displ to get the amt that has to be read in
	HRLM	S,CMD			;store this amt (negated) in the input command
AGAIN1:	OPEN	4,DSK17			;LOOKUP the NEWS file for reading in the story
	ERROR	OPEN FAILED ON DSK
	MOVE	A,[' APSYS']
	MOVEM	A,NEWSF+3		;store ppn of [ap,sys] in lookup block
	LOOKUP	4,NEWSF
	JRST	[RELEASE 4,		;NEWS file in use. wait and try the LOOKUP again
		 MOVEI	A,1
		 SLEEP	A,
		 JRST	AGAIN1]
	HLRZ	A,INDEX+1(X)		;get the record nbr for this story
	USETI	4,(A)			;select that record for input from NEWS
	IN	4,CMD			;read in the story in STORY area
	JRST	.+2
	ERROR	IN UUO FAILED TO READ IN NEWS STORY
	RELEAS	4,

	ADDI	D,STORY			;make DISPL into ptr to first word of the story
	MOVEM	D,BEGS#
	MOVEM	X,CURX#
	LDB	B,[POINT 7,(D),6]	;CALCULATE APPARENT SEQ NBR OF STORY READ
	SUBI	B,60			;	IN FROM NEWS
	IMULI	B,=10
	LDB	C,[POINT 7,(D),13]
	ADDI	B,-60(C)
	IMULI	B,=10
	LDB	C,[POINT 7,(D),20]
	ADDI	B,-60(C)
	HRRZ	A,INDEX+2(X)	;GET SEQ NBR FROM INDEX FOR THIS STORY
	CAMN	A,B		;CHECK CALCULATED SEQ NBR AGAINST THAT IN INDEX
	AOS	(P)
	POPJ	P,
;READ    GETCH

READ:	MOVE	B,[POINT 7,STUFF];read in a line typed
	MOVEM	B,LINEBP
READ1:	INCHWL	C
	CAIN	C,CR
	JRST	READ4
	CAIE	C,LF
	CAIN	C,ALT
	JRST	READ5
	IDPB	C,B		;save the char
	TRNN	C,600		;any control bits on?
	JRST	READ1		;nope
	JRST	READ5
READ4:	INCHWL	C
READ5:	MOVEM	C,BRCHAR
	SETZ	C,
	IDPB	C,B
	POPJ	P,

GETCH:	ILDB	C,LINEBP	;get next char from tty
GETCH1:	CAIE	C," "		; not counting spaces
	CAIN	C,TAB		; or tabs
	JRST	GETCH
	POPJ	P,
;CLEAR   DISP

CLEAR:	DDUPG	[DDERAS↔2]
	DPYPOS	-630
	DPYSIZ	4001
	POPJ	P,

DISP:	INSKIP
	JRST	.+2
	POPJ	P,
	PUSHJ	P,CLEAR
	MOVE	A,FREND(B)
	MOVE	C,FREND+2(B)
	PUSH	P,-2(A)
	PUSH	P,-1(A)
	PUSH	P,(A)
	PUSH	P,(C)
	PUSH	P,1(C)

	MOVE	D,[CW FNCN,ALPHA,CHNL,0,FNCN,ALPHA]
	MOVEM	D,-2(A)
	MOVE	D,[CW COLM,2,HILIN,2,LOLIN,4]
	MOVEM	D,-1(A)
	MOVEI	D,-2(A)
	HRRM	D,DDHDR
	ADDI	D,1
	MOVEM	D,DDHDR+3
	SUBI	D,3(C)
	MOVNM	D,DDHDR+1

	SETZ	B,
	JRST	DISP2
DISP1:	DPB	B,A
	HLRZ	D,A
	ADDI	D,070000
	HRL	A,D
DISP2:	JUMPGE	A,DISP1
	JRST	DISP4

DISP3:	IDPB	B,C
DISP4:	TLNE	C,760000
	JRST	DISP3
	SETZM	1(C)

	DDUPG	DDHDR
	POP	P,1(C)
	POP	P,(C)
	POP	P,(A)
	POP	P,-1(A)
	POP	P,-2(A)	
	POPJ	P,
;CHRTBL

CHRTBL:	NO	;NULL
	FOLLOW	;↓
	NO	;α
	NO	;β
	NO	;∧
	NO	;¬
	NO	;ε
	NO	;π
	NO	;λ
	NO	;TAB
	NO	;LF
	MOVEDN	;VT
	MOVEUP	;FF
	NO	;CR
	NO	;∞
	NO	;∂
	NO	;⊂
	NO	;⊃
	NO	;∩
	NO	;∪
	NO	;∀
	NO	;∃
	NO	;⊗
	NO	;↔
	NO	;_
	NXSTY	;→
	NO	;~
	NO	;≠
	NO	;≤
	NO	;≥
	NO	;≡
	NO	;∨
	NO	;SPACE
	NO	;!
	NO	;"
	NO	;#
	NO	;$
	NO	;%
	NO	;&
	NO	;'
	NO	;(
	NO	;)
	NO	;*
	PLUS	;+
	NO	;,
	MINUS	;-
	NO	;.
	NO	;/
	NUMBER	;0
	NUMBER	;1
	NUMBER	;2
	NUMBER	;3
	NUMBER	;4
	NUMBER	;5
	NUMBER	;6
	NUMBER	;7
	NUMBER	;8
	NUMBER	;9
	NO	;:
	NO	;;
	BACK	;<
	OUTSEQ	;=
	AHEAD	;>
	NO	;?
	NO	;@
	ALTER	;A
	BOTTOM	;B
	NO	;C
	EDDT	;D
	LEAVE	;E
	NO	;F
	NO	;G
	NO	;H
	NO	;I
	NO	;J
	NO	;K
	NO	;L
	NO	;M
	NEWEST	;N
	OLDEST	;O
	NO	;P
	NO	;Q
	NO	;R
	REDAP	;S
	TOP	;T
	NO	;U
	REDRAW	;V
	NO	;W
	NO	;X
	NO	;Y
	NO	;Z
	NO	;[
	NO	;\
	NO	;]
	ORIGI	;↑
	PRSTY	;←
	NO	;`
	ALTER	;a
	BOTTOM	;b
	NO	;c
	EDDT	;d
	LEAVE	;e
	NO	;f
	NO	;g
	NO	;h
	NO	;i
	NO	;j
	NO	;k
	NO	;l
	NO	;m
	NEWEST	;n
	OLDEST	;o
	NO	;p
	NO	;q
	NO	;r
	REDAP	;s
	TOP	;t
	NO	;u
	REDRAW	;v
	NO	;w
	NO	;x
	NO	;y
	NO	;z
	NO	;{
	NO	;|
	NO	;ALT
	NO	;}
	NO	;BS

	END	DAP